home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PROGEDIT / 1023.ZIP / SYSUTIL.PAS < prev   
Pascal/Delphi Source File  |  1986-03-13  |  5KB  |  222 lines
  1.  
  2. function Exist(FileN: Str80): boolean;
  3. var F: file;
  4. begin
  5.    assign(F,FileN);
  6.    reset(F);
  7.    if ioresult <> 0 then Exist:=false
  8.    else
  9.    begin
  10.       Exist:=true;
  11.       close(F);
  12.    end;
  13. end;
  14.  
  15.  
  16. procedure sysUtil;
  17. var
  18.    s,Ldir : string[64];
  19.   cmdfilename : string[255];
  20.    Hx : integer;
  21.    selection,sch : char;
  22.    PGMFILE : file;
  23.   sourcename,destname : string[64];
  24.  
  25. procedure showdir;
  26. begin
  27.   gotoxy(3,22);
  28.   getdir(0,s);
  29.   Ldir := s;
  30.   write('Current drive\directory ',s,'':78-(25+length(s)));
  31. end;
  32.  
  33. procedure flash;
  34. begin
  35.   repeat
  36.     write(' Press Any Key to Continue!');
  37.     delay(250);
  38.     for Hx := 1 to 27 do write(^H);
  39.     write('':27);
  40.     for Hx := 1 to 27 do write(^H);
  41.     delay(100);
  42.   until keypressed;
  43.   read(kbd,sch);
  44. end;
  45.  
  46. procedure prompt(s : str80; ypos :integer);
  47. begin
  48.   gotoxy(1,25);clreol;
  49.   gotoxy(1,ypos);clreol;
  50.   write(s);
  51. end;
  52.  
  53. PROCEDURE Changedir;
  54. var s: string[30];
  55. begin
  56.   prompt('Change directory to: ',24);
  57.   readln(s);
  58.   ChDir(s);
  59.   if ioerr then write('not found') else
  60.   write(' Done!');
  61.   flash;
  62. end;
  63.  
  64.   PROCEDURE MakeDir;
  65. var s: string[30];
  66. begin
  67.   prompt('Make Sub-Directory: ',24);
  68.   readln(s);
  69.   MkDir(s);
  70.   if ioerr then exit;
  71.   write(' Done!');
  72.   flash;
  73. end;
  74.  
  75. PROCEDURE RemoveDir;
  76. var s: string[30];
  77. begin
  78.   prompt('Delete Sub-Directory: ',24);
  79.   readln(s);
  80.   prompt('Confirm Removal of: ',24); write(s, ' ? Y/N');
  81.   read(kbd,sch);
  82.   if sch in ['Y','y'] then
  83.   begin
  84.     RmDir(s);
  85.     if ioerr then exit
  86.      else  write(' Done!');
  87.     flash;
  88.   end;
  89. end;
  90.  
  91.  
  92. PROCEDURE erasefile;
  93. var filename1 : string[15];
  94.     filevar : file;
  95. begin
  96.   prompt('File Name to be Erased: ',24);
  97.   readln(filename1);
  98.   prompt('Confirm Removal of: ',24); write(filename1, ' ? Y/N');
  99.   read(kbd,sch);
  100.   if sch in ['Y','y'] then
  101.   begin
  102.     if exist(filename1) then
  103.     begin
  104.       assign(filevar,filename1);
  105.       erase(filevar);
  106.       if ioerr then exit;
  107.       write(' Done! ');
  108.     end
  109.     else write(chr(7),'File "',filename1,'" not found!');
  110.     flash;
  111.   end;
  112. end;
  113.  
  114. PROCEDURE renamefile;
  115. var filename1,filename2 : string[15];
  116.     filevar : file;
  117. begin
  118.   prompt('File Name to be changed: ',24);
  119.   readln(filename1);
  120.   if exist(filename1) then
  121.   begin
  122.     gotoxy(1,24); clreol;
  123.     write('Change "',Filename1,'" to:  ');
  124.     readln(filename2);
  125.     if (not exist(filename2)) then
  126.     begin
  127.       assign(filevar,filename1);
  128.       rename(filevar,filename2);
  129.       if ioerr then
  130.       begin
  131.       close(filevar); exit;
  132.       end else close(filevar);
  133.       write(' Done ');
  134.     end
  135.     else write(chr(7),' File "',filename2,'" already exists !!');
  136.   end
  137.   else write(chr(7),' File ',filename1,' not on disk !!');
  138.   flash;
  139. end;
  140.  
  141. PROCEDURE lv(s: str80);
  142. begin
  143.   lowvideo;
  144.   write(s);
  145.   highvideo;
  146. end;
  147.  
  148. PROCEDURE hv(s : str80);
  149. begin
  150.   highvideo;
  151.   write(s);
  152. end;
  153.  
  154. PROCEDURE System_Util;
  155. var I : integer;
  156. BEGIN
  157. repeat
  158.   clrscr;
  159.   gotoxy(1,1);
  160.   WRITE(CHR(201));  {LEFT TOP CORNER}
  161.   GOTOXY(2,1);
  162.   FOR I := 1 TO 78 DO WRITE(CHR(205)); {TOP LINE};
  163.   GOTOXY(1,2);
  164.   FOR I :=  1 TO 22 DO WRITELN(CHR(186));  {LEFT SIDE}
  165.   GOTOXY(80,1);
  166.   WRITE(CHR(187));            {RIGHT TOP CORNER}
  167.   FOR I := 2 TO 22 DO
  168.     BEGIN
  169.       GOTOXY(80,I);        { RIGHT SIDE}
  170.       WRITE(CHR(186));
  171.     END;
  172.   GOTOXY(80,23);
  173.   WRITE(CHR(188));       {RIGHT BOTTOM CORNER}
  174.   GOTOXY(1,23);
  175.   WRITE(CHR(200));
  176.   GOTOXY(2,23);
  177.   FOR I := 1 TO 78 DO WRITE(CHR(205));
  178.   GOTOXY(2,3);
  179.   FOR I := 1 TO 78 DO WRITE(CHR(205));
  180.   GOTOXY(24,2);
  181.   hv('  S'); lv('ystem   '); hv('U');lv('tilities   ');hv('M');lv('enu');
  182.   I := 0;
  183.   gotoxy(10,20); lv('(Press Letter for Utility Desired or ''Q'' to Quit)');
  184.  IF SELECTION IN ['C','D','M','L'] THEN  showdir
  185.  else
  186.    begin
  187.      gotoxy(3,22);
  188.      write('Current drive\directory ',s,'':76-(26+length(s)));
  189.    end;
  190.   gotoxy(20,6);   hv(' ''C''  -  ');lv('Change Logged Directory');
  191.   gotoxy(20,8);   hv(' ''D''  -  ');lv('Delete Sub Directory');
  192.   gotoxy(20,10);  hv(' ''E''  -  ');lv('Erase a file');
  193.   gotoxy(20,12);  hv(' ''L''  -  ');lv('List Directory of Disk');
  194.   gotoxy(20,14);  hv(' ''M''  -  ');lv('Make Sub Directory');
  195.   gotoxy(20,16);  hv(' ''R''  -  ');lv('Rename a file');
  196.   gotoxy(20,18);
  197.   write('      Select Choice:  ');
  198.   repeat
  199.     read(kbd,Selection);
  200.     Selection := Upcase(Selection);
  201.  until Selection in ['C'..'E','L','M','Q','R'];
  202.  case selection of
  203.  'C' : ChangeDir;
  204.  'D' : RemoveDir;
  205.  'E' : erasefile;
  206.  'L' : begin gotoxy(1,25); clreol; ListDIR; flash; end;
  207.  'M' : MakeDir;
  208.  'R' : Renamefile;
  209.  end;
  210. until selection in['Q','X'];
  211.  end;
  212.  
  213.  
  214. begin
  215.   clrscr;
  216.   getdir(0,s);
  217.   if ioerr then clrscr;
  218.   Ldir := s;
  219.   system_Util;
  220.   clrscr;
  221. end;
  222.